home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
EnigmA Amiga Run 1996 June
/
EnigmA AMIGA RUN 08 (1996)(G.R. Edizioni)(IT)[!][issue 1996-06][EARSAN CD VII].iso
/
earcd
/
comm2
/
statty25.lha
/
statty
/
statty.rexx
< prev
Wrap
OS/2 REXX Batch file
|
1996-05-08
|
24KB
|
803 lines
/*
** $VER: statty.rexx 2.5 (7.5.96) Rolf Rotvel
**
** Uses rexxtricks.library
*/
log.path = 'logs:spot.log.max' /* Path to tosser logfile */
area.path = 'mail:max/spot.areas' /* Path to tosser areas file */
out.path = 'fido:statty.out' /* Path to Statty's outputfile */
db.path = 'fido:statty.db' /* Path to Statty's database */
keeplog? = 1 /* Boolean. Create backup of logfile */
keeplogname = '' /* Name of backup log (Default: <log.path>.statty) */
allareas? = 1 /* Boolean. Include areas with no flow in output */
toyou? = 1 /* Boolean. Show msgs to (Or from) you in output */
excludefile = '' /* Path to excludefile. '' if none */
/*
** End of cfg.
*/
arg tosser
signal on syntax
signal on error
call addlib('rexxsupport.library', 0, -30, 0)
call addlib('rexxtricks.library', 0, -30, 0)
call pragma('p', -1)
template = 'FZ=FOOZLE/S,S=SPOT/S,MM=MAILMANAGER/S '
options prompt template
PARSEARG:
select
when tosser = 'FZ' | tosser = 'FOOZLE' then tosser = 'Foozle'
when tosser = 'S' | tosser = 'SPOT' then tosser = 'Spot'
when tosser = 'MM' | tosser = 'MAILMANAGER' then tosser = 'MailManager'
when tosser = '' then do
say 'Required argument missing'
say template
exit
end
when tosser = '?' then do
pull tosser
signal parsearg
end
otherwise do
say 'Bad argument'
say template
exit
end
end
if ~exists(log.path) then call errorexit ('Can''t find '||log.path)
if ~exists(area.path) then call errorexit ('Can''t find '||area.path)
start.thisdb = date()||' '||left(time(), 5)
if keeplog? then do
if keeplogname ~= '' then oldpath = makepath(pathpart(log.path), keeplogname)
else oldpath = log.path||'.statty'
say 'Backing up log as '||oldpath
if exists(oldpath) then call appendfile(log.path, oldpath)
else call copyfile(log.path, oldpath)
end
exc = ''
if excludefile ~= '' then do
if open('tmp', excludefile, 'r') then do
say 'Reading '||excludefile
exc = readch('tmp', 65535)
call close('tmp')
end
end
if exists(db.path) then do
say 'Reading '||db.path
if ~readfile(db.path, line) then call errorexit ('Error reading '||db.path)
parse var line.1 '"' start.firstdb '"' '"' start.lastdb '"' areastamp total.dbmsgs total.dbtoyou total.dbfromyou .
parse value statef(area.path) with . . . . days mins ticks .
chkstamp = days||mins||ticks
if areastamp ~= chkstamp then do
areastamp = chkstamp
num = 1
area.length = 0
interpret 'call '||tosser||'area'
do d = 2 to line.0
parse var line.d _name _msgs _toyou _fromyou .
if lsearch(_name, area.name) = -1 then iterate
db.name.num = _name
db.msgs.num = _msgs
db.toyou.num = _toyou
db.fromyou.num = _fromyou
num = num + 1
end
db.name.0 = num - 1
end
else do
num = 1
area.length = 0
do d = 2 to line.0
parse var line.d _name _msgs _toyou _fromyou .
if pos('"'||_name||'"', exc) > 0 then iterate
area.name.num = _name
area.length = max(area.length, length(_name))
db.name.num = _name
db.msgs.num = _msgs
db.toyou.num = _toyou
db.fromyou.num = _fromyou
num = num + 1
end
area.name.0 = num - 1
db.name.0 = area.name.0
end
end
else do
area.length = 0
interpret 'call '||tosser||'area'
start.firstdb = start.thisdb
start.lastdb = start.thisdb
parse value statef(area.path) with . . . . days mins ticks .
areastamp = days||mins||ticks
total.dbmsgs = 0
total.dbtoyou = 0
total.dbfromyou = 0
do a = 1 to area.name.0
db.name.a = area.name.a
db.msgs.a = 0
db.toyou.a = 0
db.fromyou.a = 0
end
end
total.logmsgs = 0
total.logtoyou = 0
total.logfromyou = 0
interpret 'call '||tosser||'log'
if total.logmsgs = 0 then say 'No new messages to process. Exiting'
else do
call calculatedb
call putdb
call sortoutput
call genoutput
end
if ~delete(log.path) then call errorexit('Error deleting '||log.path)
say 'Finished'
exit
ERROREXIT:
say arg(1)
exit 10
SPOTAREA: procedure expose area. exc
say 'Reading '||area.path
if ~readfile(area.path, line) then call errorexit('Error reading '||area.path)
num = 1
do a = 1 to line.0
chk = upper(line.a)
/* Skip separator, bad, default & netmail areas */
if pos(' SEPARATOR', chk) > 0 | pos(' BAD', chk) > 0 |,
pos(' DEFAULT', chk) > 0 | pos(' NETMAIL', chk) > 0 then iterate
parse var line.a . '"' . '"' '"' _name '"'
/* Is areaname in excludefile? */
if pos('"'||_name||'"', exc) > 0 then iterate
/* A duplicate areaname?!? */
if lsearch(_name, area.name) ~= -1 then call errorexit,
('Found duplicate areaname "'||_name||'" twice in '||area.path||'!')
area.name.num = _name
area.name.0 = num /* Needed for lsearch() */
area.length = max(area.length, length(_name))
num = num + 1
end
return
FOOZLEAREA: procedure expose area. exc
say 'Reading '||area.path
if ~open('tmp', area.path, 'r') then call errorexit('Error reading '||area.path)
num = 1
null = '0'x
do forever
_name = readch('tmp', 24) /* Read areaname */
if eof('tmp') then leave /* Break condition */
tag = upper(strip(readch('tmp', 24), 't', null) /* Read tagname */
dir = compress(readch('tmp', 32), null) /* Read areadir */
call seek('tmp', 128 + 520) /* Skip rest of area definition */
/* Iterate if not valid area ? */
if dir = '' | ~exists(dir) | tag = 'BAD' |,
tag = 'MATRIX' then iterate
_name = strip(_name, 't', null)
if pos('"'||_name||'"', exc) > 0 then iterate /* Check excludefile */
/* A duplicate areaname?!? */
if lsearch(_name, area.name) ~= -1 then call errorexit,
('Found duplicate areaname "'||_name||'" twice in '||area.path||'!')
area.name.num = _name
area.name.0 = num /* Needed for lsearch() */
area.length = max(area.length, length(_name))
num = num + 1
end
call close('tmp')
return
MAILMANAGERAREA: procedure expose area. exc
say 'Reading '||area.path
if ~readfile(area.path, line) then call errorexit('Error reading '||area.path)
taglen = 20 /* In MM log tagnames are cut off after <taglen> chars */
num = 1
start = 1
do forever
/* Skip bad, netmail, fileecho & tick areas */
a = lsearch("'#ECHOAREA *", line, start,, pattern)
if a = -1 then leave
start = a + 1
parse var line.a . '"' . '"' _name .
if pos('"'||_name||'"', exc) > 0 then iterate
if length(_name) > taglen then do
subname = left(_name, taglen)
chk = lsearch(subname||'*', area.name,,, 'p')
/* Found two tagnames where first <taglen> chars are the same */
if chk ~= -1 then call tagerror(taglen, _name, area.name.chk)
end
area.name.num = _name
area.name.0 = num
area.length = max(area.length, length(area.name.num))
num = num + 1
end
return
TAGERROR: procedure
nl = '0a'x
call errorexit('In MM log tagnames are cut off after '||arg(1)||' chars.'||nl||,
arg(2)||' and'||nl||,
arg(3)||nl||,
'will therefore look the same to Statty.'||nl||,
'You must include one of them in the excludefile.')
return /* Never returns...*/
SPOTLOG: procedure expose total. log. area.
say 'Reading '||log.path
if ~readfile(log.path, line) then call errorexit('Error reading '||log.path)
num = 1
startexp = 'Export startet'
endexp = 'Export ended'
export? = 0
do l = 1 to line.0
first = left(line.l, 1)
select
when pos(startexp, line.l) > 0 then export? = 1
when pos(endexp, line.l) > 0 then export? = 0
when first = '*' | first = '!' then do
parse var line.l . "'" _name "'" rest
/* Iterate if it's not a valid areaname */
if lsearch(_name, area.name) = -1 then iterate
/* Find amount of msgs imported */
wds = words(rest)
do w = 1 to wds
_msgs = word(rest, w)
if datatype(_msgs, 'w') then do
total.logmsgs = total.logmsgs + _msgs
leave
end
end
/* Parse rest of line if any msgs for you */
if ~export? then do
if first = '*' then do ww = w + 1 to wds
_toyou = word(rest, ww)
if datatype(_toyou, 'w') then do
total.logtoyou = total.logtoyou + _toyou
leave
end
end
else _toyou = 0
/* Is it first time we find this areaname in logfile? */
chk = lsearch(_name, log.name)
if chk = -1 then do /* Initialize variables */
log.name.num = _name
log.msgs.num = _msgs
log.toyou.num = _toyou
log.fromyou.num = 0
log.name.0 = num /* Need this for lsearch() */
num = num + 1
end
else do /* Update variables */
log.msgs.chk = log.msgs.chk + _msgs
log.toyou.chk = log.toyou.chk + _toyou
end
end
else do /* Export! */
chk = lsearch(_name, log.name)
if chk = -1 then do /* Initialize variables */
log.name.num = _name
log.msgs.num = _msgs
log.toyou.num = 0
log.fromyou.num = _msgs
log.name.0 = num /* Need this for lsearch() */
num = num + 1
end
else do /* Update variables */
log.msgs.chk = log.msgs.chk + _msgs
log.fromyou.chk = log.fromyou.chk + _msgs
end
total.logfromyou = total.logfromyou + _msgs
end
end
otherwise nop
end
end
return
FOOZLELOG: procedure expose total. log. area.
say 'Reading '||log.path
if ~readfile(log.path, line) then call errorexit('Error reading '||log.path)
num = 1
do l = 1 to line.0
if word(line.l, 4) = 'Area' then do
parse var line.l . '"' _name '"' rest
/* Iterate if it's not a valid areaname */
if lsearch(_name, area.name) = -1 then iterate
/* Find amount of msgs imported */
wds = words(rest)
do w = 1 to wds
_msgs = word(rest, w)
if datatype(_msgs, 'w') then do
total.logmsgs = total.logmsgs + _msgs
leave
end
end
/* Parse rest of line if any msgs for you */
if right(line.l, 7) = 'for you' then do ww = w + 1 to wds
_toyou = word(rest, ww)
if datatype(_toyou, 'w') then do
total.logtoyou = total.logtoyou + _toyou
leave
end
end
else _toyou = 0
/* Is it first time we find this areaname in logfile? */
chk = lsearch(_name, log.name)
if chk = -1 then do /* Initialize variables */
log.name.num = _name
log.msgs.num = _msgs
log.toyou.num = _toyou
log.fromyou.num = 0 /* Foozle doesn't support this...*/
log.name.0 = num /* Need this for lsearch() */
num = num + 1
end
else do /* Update variables */
log.msgs.chk = log.msgs.chk + _msgs
log.toyou.chk = log.toyou.chk + _toyou
end
end
end
return
MAILMANAGERLOG: procedure expose total. log. area.
say 'Reading '||log.path
if ~readfile(log.path, line) then call errorexit('Error reading '||log.path)
num = 1
startimp = 'Import Statistics'
endimp = 'Import Used'
startexp = 'Start Export Function'
endexp = 'End Export Function'
action = ''
do l = 1 to line.0
if action = '' then do
select
when pos(startimp, line.l) > 0 then action = 'imp'
when pos(startexp, line.l) > 0 then action = 'exp'
otherwise nop
end
end
else do
select
when pos(endimp, line.l) > 0 then action = ''
when pos(endexp, line.l) > 0 then action = ''
when word(line.l, 7) = 'Area' then do
if action = 'imp' then do
parse var line.l . 'Area' _name _msgs '(' _toyou ')'
/* Iterate if it's not a valid areaname */
/* Have to use a pattern here. MM doesn't show full tagname in log */
if lsearch(_name||'*', area.name,,, 'p') = -1 then iterate
_msgs = strip(_msgs)
total.logmsgs = total.logmsgs + _msgs
_toyou = strip(_toyou)
total.logtoyou = total.logtoyou + _toyou
/* Is it first time we find this areaname in logfile? */
chk = lsearch(_name, log.name)
if chk = -1 then do /* Initialize variables */
log.name.num = _name
log.msgs.num = _msgs
log.toyou.num = _toyou
log.fromyou.num = 0
log.name.0 = num /* Need this for lsearch() */
num = num + 1
end
else do /* Update variables */
log.msgs.chk = log.msgs.chk + _msgs
log.toyou.chk = log.toyou.chk + _toyou
end
end
else do /* Standalone export */
parse var line.l . 'Area' _name _fromyou .
if lsearch(_name||'*', area.name,,, 'p') = -1 then iterate
total.logmsgs = total.logmsgs + _fromyou
total.logfromyou = total.logfromyou + _fromyou
chk = lsearch(_name, log.name)
if chk = -1 then do /* Initialize variables */
log.name.num = _name
log.msgs.num = _fromyou
log.toyou.num = 0
log.fromyou.num = _fromyou
log.name.0 = num /* Need this for lsearch() */
num = num + 1
end
else do /* Update variables */
log.msgs.chk = log.msgs.chk + _fromyou
log.fromyou.chk = log.fromyou.chk + _fromyou
end
end
end
otherwise nop
end
end
end
return
CALCULATEDB: procedure expose area. log. db.
say 'Calculating database'
area.maxmsgs = 0
area.maxtoyou = 0
area.maxnewmsgs = 0
area.maxnewtoyou = 0
area.maxfromyou = 0
area.maxnewfromyou = 0
do a = 1 to area.name.0
chklog = lsearch(area.name.a, log.name)
if chklog = -1 then do
area.newmsgs.a = 0
area.newtoyou.a = 0
area.newfromyou.a = 0
end
else do
area.newmsgs.a = log.msgs.chklog
area.newtoyou.a = log.toyou.chklog
area.newfromyou.a = log.fromyou.chklog
end
chkdb = lsearch(area.name.a, db.name)
if chkdb = -1 then do
dbmsgs = 0
dbtoyou = 0
dbfromyou = 0
end
else do
dbmsgs = db.msgs.chkdb
dbtoyou = db.toyou.chkdb
dbfromyou = db.fromyou.chkdb
end
/* These variables needed when calculating/formatting output */
area.msgs.a = area.newmsgs.a + dbmsgs
area.toyou.a = area.newtoyou.a + dbtoyou
area.fromyou.a = area.newfromyou.a + dbfromyou
area.maxmsgs = max(area.msgs.a, area.maxmsgs)
area.maxtoyou = max(area.toyou.a, area.maxtoyou)
area.maxfromyou = max(area.fromyou.a, area.maxfromyou)
area.maxnewmsgs = max(area.newmsgs.a + area.newtoyou.a, area.maxnewmsgs)
area.maxnewtoyou = max(area.newtoyou.a, area.maxnewtoyou)
area.maxnewfromyou = max(area.newfromyou.a, area.maxnewfromyou)
end
area.msgs.0 = area.name.0
return
PUTDB: procedure expose db. area. total. start. areastamp
say 'Writing '||db.path
total.msgs = total.dbmsgs + total.logmsgs
total.toyou = total.dbtoyou + total.logtoyou
total.fromyou = total.dbfromyou + total.logfromyou
line.1 = '"'||start.firstdb||'" "'||start.thisdb||'" '||areastamp||' '||total.msgs||' '||total.toyou||' '||total.fromyou
num = 2
do a = 1 to area.name.0
line.num = area.name.a||' '||area.msgs.a||' '||area.toyou.a||' '||area.fromyou.a
num = num + 1
end
line.0 = num - 1
if ~writefile(db.path, line) then call errorexit('Error writing '||db.path)
return
SORTOUTPUT: procedure expose area.
say 'Sorting areas'
m = 1 /* Define m for passes */
do while (9 * m + 4) < area.msgs.0
m = m * 3 + 1
end
do while m > 0 /* Sort stem */
k = area.msgs.0 - m
do j = 1 to k
q = j
do while q > 0
l = q + m
if area.msgs.q <= area.msgs.l then leave
tmpq = area.name.q||' '||area.msgs.q||' '||area.toyou.q||' '||area.fromyou.q||' '||area.newmsgs.q||' '||area.newtoyou.q||' '||area.newfromyou.q
tmpl = area.name.l||' '||area.msgs.l||' '||area.toyou.l||' '||area.fromyou.l||' '||area.newmsgs.l||' '||area.newtoyou.l||' '||area.newfromyou.l
parse var tmpl area.name.q area.msgs.q area.toyou.q area.fromyou.q area.newmsgs.q area.newtoyou.q area.newfromyou.q .
parse var tmpq area.name.l area.msgs.l area.toyou.l area.fromyou.l area.newmsgs.l area.newtoyou.l area.newfromyou.l .
q = q - m
end
end
m = m % 3
end
return
GENOUTPUT: procedure expose start. total. area. out. tosser allareas? toyou?
say 'Writing '||out.path
if total.fromyou > 0 then fromyou? = 1
else fromyou? = 0
msg_len = length(area.maxmsgs)
newmsg_len = length(area.maxnewmsgs)
if toyou? then do
toyou_len = length(area.maxtoyou)
newtoyou_len = length(area.maxnewtoyou)
pad_len = msg_len + 1 + 1 + toyou_len + 1 /* A space + '()' */
if fromyou? then do
fromyou_len = length(area.maxfromyou)
newfromyou_len = length(area.maxnewfromyou)
pad_len = pad_len + 1 + fromyou_len /* A space */
end
end
else pad_len = msg_len
select
when pad_len = 1 then width = 5
when pad_len = 2 then width = 4
otherwise width = 3
end
spaces = makespaces(width)
spaces_minus_one = makespaces(width - 1) /* '100%' kludge */
line.1 = tosser||' mailflow database created by '||subword(sourceline(2), 3, 2)
line.2 = ''
line.3 = 'Database was started: '||start.firstdb
line.4 = 'Messages in database: '||total.msgs
if toyou? then do
if fromyou? then line.4 = line.4||' ('||total.toyou||' to you, '||total.fromyou||' from you)'
else line.4 = line.4||' ('||total.toyou||' to you)'
end
line.5 = ''
line.6 = 'This update: '||start.thisdb
line.7 = 'Last update: '||start.lastdb
line.8 = total.logmsgs||' new messages'
if toyou? then do
if fromyou? then line.8 = line.8||' ('||total.logtoyou||' to you, '||total.logfromyou||' from you)'
else line.8 = line.8||' ('||total.logtoyou||' to you)'
end
line.8 = line.8||' in '||area.name.0||' areas'
line.9 = ''
line.10 = left('Areaname', area.length)||spaces||left('%', 5)||spaces||,
left('Total', pad_len + width)||'New'
line.11 = ''
num = 12 /* Number of lines in header + 1 */
do q = area.msgs.0 to 1 by -1
if ~allareas? & area.msgs.q = 0 then leave
if toyou? then do
if fromyou? then do
youtotal = ' ('||right(area.toyou.q, toyou_len)||' '||right(area.fromyou.q, fromyou_len)||')'
younew = ' ('||right(area.newtoyou.q, newtoyou_len)||' '||right(area.newfromyou.q, newfromyou_len)||')'
end
else do
youtotal = ' ('||right(area.toyou.q, toyou_len)||')'
younew = ' ('||right(area.newtoyou.q, newtoyou_len)||')'
end
end
else do
youtotal = ''
younew = ''
end
line.num = left(strip(area.name.q), area.length)||spaces_minus_one||,
format(((area.msgs.q / total.msgs) * 100), 3, 2)||spaces||,
right(area.msgs.q, msg_len)||youtotal||spaces||,
right(area.newmsgs.q, newmsg_len)||younew
num = num + 1
end
line.0 = num - 1
if ~writefile(out.path, line) then call errorexit('Error writing '||out.path)
return
/*
** Generic procedures
*/
MAKESPACES:
return copies(' ', arg(1))
/*
** format(<number>, [<before>], [<after>])
**
** If number alone is supplied, the result is the same as that returned by
** the expression <number> + 0: leading 0's are removed from the number and
** it is formatted according to the current setting of NUMERIC DIGITS .
**
** If <before> is supplied, it must be a number equal to or greater than the
** length in the integer part of <number>. The result will be returned
** right-justified to <before> spaces.
**
** If <after> is supplied, it must be a number. The fractional part of
** <number> is rounded (not just truncated) to <after> digits.
*/
FORMAT: procedure
arg number, before, after
/* Reformats the number to NUMERIC DIGITS setting */
num = number + 0
/* Return the reformatted number if other options not specified */
if before = '' & after = '' then return num
/* Split the number into fraction and integer */
parse var num integer '.' fraction
/* Set defaults for non-spec'd arguments */
if before = '' then before = length(integer)
if after = '' then after = length(fraction)
/* [before] argument must be at least as long as integer */
if before < length(integer) then return '**ERROR**'
/* add an appropriate value of .5 to number to round it */
if after ~= length(fraction) then do
fraction = trunc(('.'||fraction||'0') + ('.'||copies('0', after)||'5'), after)
/* Numbers created as text strings are still numbers */
integer = integer + (fraction % 1)
fraction = substr(fraction, 3)
end
if fraction >= 0 then return right(integer, before)||'.'||fraction
else return right(integer, before)
/*
** copyfile(sourcefile, destfile)
*/
COPYFILE: procedure
parse arg from, to .
sz = word(statef(from), 2)
call open('s', from, 'r')
call open('d', to, 'w')
do (sz % 65535) + 1
call writech('d', readch('s', 65535))
end
call close('d')
call close('s')
return
/*
** appendfile(sourcefile, destfile)
*/
APPENDFILE: procedure
parse arg from, to .
sz = word(statef(from), 2)
call open('s', from, 'r')
call open('d', to, 'a')
do (sz % 65535) + 1
call writech('d', readch('s', 65535))
end
call close('d')
call close('s')
return
/*
** Use while developing...
*/
SYNTAX:
ERROR:
trace o
err = rc ; line = sigl
if datatype(err, 'n') then do
errline = 'Error '||err||': '||errortext(err)||'0a'x||'in line '||line
sayit? = 1
if show('p', 'rexx_ced') then do
parse source . . filename .
options results
address 'rexx_ced'
'cedtofront'
'ow' filename
'jump to line' line
'okay1' errline
sayit? = 0
end
else say errline
end
exit
